OHI British Columbia | OHI Science | Citation policy
knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'Figs/',
echo = TRUE, message = FALSE, warning = FALSE)
library(ohicore) ### devtools::install_github('ohi-science/ohicore')
source('~/github/ohibc/src/R/common.R')
dir_ohibc <- '~/github/ohibc'
dir_calc <- file.path(dir_ohibc, 'calc_ohibc')
dir_master <- file.path(dir_calc, 'master')
source(file.path(dir_calc, 'calc_scores_fxns.R'))
### provenance tracking
# library(provRmd); prov_setup()source('~/github/ohibc/src/R/plot_flower.R')
index_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(region_id == 0) %>%
filter(dimension %in% c('score')) %>%
filter(goal != 'Index')
plot_wts <- read_csv(file.path(dir_calc, 'conf/goals.csv')) %>%
select(order = order_hierarchy,
goal, parent, goal_label = name_flower,
weight)
index_scores <- index_scores %>%
left_join(plot_wts, by = 'goal') %>%
arrange(order) %>%
filter(!goal %in% plot_wts$parent)
for(yr in index_scores$year %>% unique() %>% sort()) {
# yr <- 2016
scores_tmp <- index_scores %>%
filter(year == yr)
index_flower <- plot_flower(scores_tmp, show_plot = FALSE) +
labs(title = paste0('OHIBC ', yr))
print(index_flower)
}scores_all <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(region_id == 0) %>%
spread(dimension, score) %>%
group_by(goal, region_id) %>%
mutate(pred_future_status = lag(future, 5)) %>%
arrange(year)
score_compare_plot <- ggplot(scores_all, aes(x = pred_future_status, y = status, color = goal)) +
ggtheme_plot() +
geom_abline(slope = 1, intercept = 0, color = 'darkred') +
geom_point(size = 2, aes(label = year)) +
geom_path(aes(group = goal, label = year))
plotly::ggplotly(score_compare_plot)scores_rgn <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(region_id != 0) %>%
spread(dimension, score) %>%
group_by(goal, region_id) %>%
mutate(pred_future_status = lag(future, 5)) %>%
arrange(year) %>%
left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))
goals <- scores_rgn$goal %>% unique()
for(goalname in goals) { # goalname <- goals[1]
tmp_df <- scores_rgn %>%
filter(goal == goalname)
tmp_labels <- tmp_df %>%
group_by(rgn_name, rgn_code) %>%
filter(!is.na(pred_future_status) & !is.na(status)) %>%
summarize(x = last(pred_future_status),
y = last(status))
# summarize(x = mean(pred_future_status, na.rm = TRUE),
# y = mean(status, na.rm = TRUE))
rgn_score_compare_plot <- ggplot(tmp_df,
aes(x = pred_future_status, y = status, color = rgn_name)) +
ggtheme_plot() +
geom_abline(slope = 1, intercept = 0, color = 'darkred') +
geom_point(size = 2, aes(label = year)) +
geom_path(aes(group = rgn_name, label = year), alpha = .4) +
geom_text(data = tmp_labels, aes(x, y, label = rgn_code), color = 'grey30') +
labs(title = goalname,
color = goalname)
print(rgn_score_compare_plot)
}scores_all <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
filter(region_id == 0) %>%
filter(goal != 'Index') %>%
filter(dimension %in% c('status', 'future')) %>%
mutate(dimension = str_replace(dimension, 'status', 'obs_status'),
dimension = str_replace(dimension, 'future', 'pred_status'),
year = ifelse(dimension == 'pred_status', year + 5, year))
for(gl in (scores_all$goal %>% unique())) { ### gl = 'AO'
scores_goal <- scores_all %>%
filter(goal == gl)
score_compare_plot <- ggplot(scores_goal, aes(x = dimension, y = score, label = year)) +
ggtheme_plot() +
geom_point(size = 2) +
geom_line(size = 1, alpha = .5, aes(group = year), alpha = .7) +
labs(y = gl)
print(score_compare_plot)
}Clipped to 1990 and later; some data layers go back farther but these will not typically inform scores except as reference points.
layer_targets <- read_csv(file.path(dir_calc, 'explore/int/layers_targets_master.csv')) %>%
select(-target_element, -dimension) %>%
distinct()
data_years <- read_csv(file.path(dir_calc, 'master/all_data_years.csv'))
# no_year_spans <- layer_targets %>%
# filter(!layer %in% data_years$layer_name) %>%
# group_by(layer) %>%
# summarize(targets = paste(target, collapse = ', '))
#
# knitr::kable(no_year_spans) %>% paste(collapse = '')
year_spans <- data_years %>%
full_join(layer_targets, by = c('layer_name' = 'layer')) %>%
filter(target != 'spatial') %>%
group_by(layer_name) %>%
filter(year >= 1990) %>%
summarize(year_min = min(year),
year_max = max(year),
targets = paste(unique(target) %>% sort(), collapse = ', ')) %>%
ungroup() %>%
arrange(layer_name) %>%
mutate(layer_name = factor(layer_name, levels = rev(.$layer_name %>% unique), ordered = TRUE))
span_plot <- ggplot(year_spans, aes(x = layer_name, color = targets)) +
ggtheme_plot(base_size = 8) +
geom_linerange(aes(ymin = year_min, ymax = year_max), show.legend = FALSE) +
labs(x = 'Layer name',
y = 'Data year') +
scale_color_manual(values = rep(brewer.pal(n = 8, name = 'Dark2'), 4)) +
geom_text(aes(y = year_max, label = targets), color = 'grey20', size = 1.6,
vjust = 0, nudge_x = 0.1, hjust = 1, show.legend = FALSE) +
coord_flip()
ggsave(file.path(dir_calc, 'explore/layers_data_years.png'), height = 6, width = 5)